home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / manchest.lha / MANCHESTER / manchester / 4.1 / Eyeball.st < prev    next >
Text File  |  1993-07-24  |  4KB  |  135 lines
  1. "    NAME        Eyeball
  2.     AUTHOR        Bernard Horan <bernard@is.morgan.com>
  3.     CONTRIBUTOR    Bernard Horan <bernard@is.morgan.com>
  4.     FUNCTION     Eyeballs follow your cursor
  5.     ST-VERSIONS    4.1
  6.     PREREQUISITES     
  7.     CONFLICTS     
  8.     DISTRIBUTION    global
  9.     VERSION        2.0
  10.     DATE        March 1993
  11.     SUMMARY        
  12. I hacked a 4.1 version of Eyeball.st (which Trevor wrote for version 2.2!!)
  13. -- though I had to change it a bit. It's a good example of the use of
  14. OpaqueImages and various palette messages. I'm still not happy with the
  15. animation, as the background can get screwed if you resize the window.
  16.  
  17. bern"
  18. 'obligatory string'!
  19.  
  20. VisualPart subclass: #EyeballView
  21.     instanceVariableNames: 'pupilPosition pupilDiameter eyeImage pupilImage pupilProcess '
  22.     classVariableNames: ''
  23.     poolDictionaries: ''
  24.     category: 'Eyeball'!
  25.  
  26.  
  27. !EyeballView methodsFor: 'initialize-release'!
  28.  
  29. release
  30.     pupilProcess isNil ifFalse:[pupilProcess terminate; release].
  31.     super release!
  32.  
  33. setDiameter: aDiameter
  34.     pupilDiameter := aDiameter.
  35.     self makePupilImage.
  36.     self startPupilProcess! !
  37.  
  38. !EyeballView methodsFor: 'displaying'!
  39.  
  40. displayOn: aGraphicsContext
  41.     eyeImage displayOn: aGraphicsContext.! !
  42.  
  43. !EyeballView methodsFor: 'bounds accessing'!
  44.  
  45. bounds: newBounds 
  46.     | pixmap figure shape |
  47.     pupilPosition isNil ifTrue:[pupilPosition := newBounds center].
  48.     pixmap := Pixmap extent: newBounds extent.
  49.     (pixmap graphicsContext) displayRectangle: newBounds; paint: ColorValue white;
  50.         displayWedgeBoundedBy: newBounds
  51.         startAngle: 0
  52.         sweepAngle: 360.
  53.     figure := pixmap asImage convertToPalette: MappedPalette blackWhite.
  54.     shape := figure copy palette: CoveragePalette monoMaskPalette.
  55.     eyeImage := OpaqueImage figure: figure shape: shape.
  56.     ^super bounds: newBounds!
  57.  
  58. preferredBounds
  59.     "Answer the Screen's bounding box.
  60.     Views are expected to be Wrapped by a BoundedWrapper."
  61.  
  62.     ^Screen default bounds! !
  63.  
  64. !EyeballView methodsFor: 'private'!
  65.  
  66. makePupilImage
  67.     | pixmap figure shape aRectangle |
  68.     aRectangle := 0 @ 0 extent: pupilDiameter asPoint.
  69.     pixmap := Pixmap extent: aRectangle extent.
  70.     pixmap graphicsContext
  71.         displayWedgeBoundedBy: aRectangle
  72.         startAngle: 0
  73.         sweepAngle: 360.
  74.     figure := pixmap asImage convertToPalette: MappedPalette whiteBlack.
  75.     shape := figure copy palette: CoveragePalette monoMaskPalette.
  76.     pupilImage := OpaqueImage figure: figure shape: shape!
  77.  
  78. startPupilProcess
  79.     | delay |
  80.     delay := Delay forMilliseconds: 250.
  81.     pupilProcess := [pupilImage
  82.                 follow: [pupilPosition - (pupilDiameter asPoint //2)]
  83.                 while: 
  84.                     [delay wait.
  85.                     self updatePupil.
  86.                     true]
  87.                 on: self graphicsContext ] newProcess.
  88.     pupilProcess resume!
  89.  
  90. updatePupil
  91.     "Update the receiver's pupil, if necessary. Answer true if 
  92.     a change was made, otherwise false."
  93.  
  94.     | newP diff sign cursorPoint |
  95.     cursorPoint := self globalPointToLocal: (InputSensor cursorPoint translatedBy: self topComponent globalOrigin negated).
  96.     diff := cursorPoint - self bounds center // 5.
  97.     sign := diff x sign @ diff y sign.
  98.     newP := self bounds center + ((diff abs min: (self bounds width // 3) asPoint)
  99.                     * sign).
  100.  
  101.     newP = pupilPosition ifFalse: [pupilPosition := newP]! !
  102. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  103.  
  104. EyeballView class
  105.     instanceVariableNames: ''!
  106.  
  107.  
  108. !EyeballView class methodsFor: 'instance creation'!
  109.  
  110. diameter: anInteger
  111.     ^self new setDiameter: anInteger! !
  112.  
  113. !EyeballView class methodsFor: 'examples'!
  114.  
  115. example1
  116.     "EyeballView example1"
  117.     | window view |
  118.     window := ScheduledWindow new.
  119.     window label: 'Eyeball'.
  120.     view := self diameter: 50.
  121.     window component: view.
  122.     window open!
  123.  
  124. example2
  125.     "EyeballView example2"
  126.     | window  comp |
  127.     window := ScheduledWindow new.
  128.     window label: 'Eyeballs'.
  129.     comp := CompositePart new.
  130.     comp add: (self diameter: 50) in: (0@0 extent: 0.5@1).
  131.     comp add: (self diameter: 50) in: (0.5 @ 0 corner: 1@1).
  132.     window component: comp.
  133.     window open! !
  134.  
  135.